home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / dev / m2 / menugadget.lha / MenuGadget.mod < prev    next >
Text File  |  1993-01-29  |  13KB  |  356 lines
  1. IMPLEMENTATION MODULE MenuGadget;
  2.  
  3.    (* MenuGadget.mod - Quellcode der Prozeduren.
  4.     * Version  : 1.01 (29.01.93)
  5.     * Compiler : M2Amiga V4.107d
  6.     * Aufruf   : m2c -zyne+@
  7.     * Copyright: © 1993 by Fin Schuppenhauer
  8.     * Dieses Programm ist SHAREWARE. Wenn es Dir gefällt und Du es
  9.     * häufiger benutzt (bzw. die hier zur Verfügung gestellten Prozeduren
  10.     * in eigene Programme einbaust), dann sende bitte eine kleine
  11.     * Entschädigung (mindestens eine Postkarte) an die folgende Adresse:
  12.     *
  13.     *       Fin Schuppenhauer
  14.     *       Braußpark 10
  15.     *       2000 Hamburg 26
  16.     *
  17.     * Für Kritik, Fehlerberichte und Verbesserungsvorschläge danke ich
  18.     * im vorraus.
  19.     *
  20.     * Zu diesem Programm gehören folgende Dateien:
  21.     *
  22.     *    ° MenuGadget.def
  23.     *    ° MenuGadget.mod     (diese Datei)
  24.     *    ° MenuGadget.sym
  25.     *    ° MenuGadget.obj
  26.     *    ° MenuGadget.readme
  27.     *    ° MenuGadgetDemo.mod
  28.     *    ° MenuGadgetDemo
  29.     *
  30.     * Diese Dateien liegen entweder in dieser Form oder gepackt als
  31.     * MenuGadget.lzh-File vor.
  32.     *
  33.     * SIE DÜRFEN NICHT VERÄNDERT WERDEN (wenn nicht anderes erklärt wird)
  34.     * UND NUR KOMPLETT ÜBER ELEKTRONISCHEN WEGE ODER AUF PUBLIC DOMAIN
  35.     * DISK WEITERGEGEBEN WERDEN. IN BEIDEN FÄLLEN DARF DIE UNKOSTENPAU-
  36.     * SCHALE NICHT DM 5.- ÜBERSCHREITEN.
  37.     * FÜR DIE FUNKTIONSFÄHIGKEIT DER PROGRAMME SOWIE MÖGLICHE SCHÄDEN
  38.     * BEI DEREN BENUTZUNG WIRD KEINE GARANTIE ÜBERNOMMEN.
  39.     *)
  40.  
  41. IMPORT   id:IntuitionD, il:IntuitionL,
  42.          gd:GadToolsD,  gl:GadToolsL,
  43.          grd:GraphicsD, grl:GraphicsL,
  44.          ed:ExecD,      el:ExecL,
  45.          ud:UtilityD;
  46. FROM Heap         IMPORT Allocate;
  47. FROM IntuitionD   IMPORT WaTags, IDCMPFlags;
  48. FROM String       IMPORT Length;
  49. FROM SYSTEM       IMPORT ADR,ADDRESS,TAG,ASSEMBLE,CAST,BITSET;
  50.  
  51.  
  52. PROCEDURE CreateGRBorder(width, height : INTEGER) : id.BorderPtr;
  53. VAR   borders  : ARRAY [1..3] OF id.BorderPtr;
  54.       koords   : ARRAY [1..3] OF POINTER TO ARRAY [1..8] OF INTEGER;
  55.       b        : SHORTINT;
  56. BEGIN
  57.    (* Using Allocate() from the modul, i don't have to take care of
  58.     * clearing the memory at the end of a program. The modul does
  59.     * this for me.
  60.     *)
  61.    FOR b := 1 TO 3 DO
  62.       Allocate (borders[b], SIZE(id.Border));
  63.       Allocate (koords[b], 2*6);
  64.    END;
  65.    (* Koordinaten für die helle Seite: *)
  66.    koords[1]^[1] := 0;       koords[1]^[2] := height-2;
  67.    koords[1]^[3] := 0;       koords[1]^[4] := 0;
  68.    koords[1]^[5] := width;   koords[1]^[6] := 0;
  69.    (* Koordinaten für die dunkle Seite: *)
  70.    koords[2]^[1] := width;   koords[2]^[2] := 1;
  71.    koords[2]^[3] := width;   koords[2]^[4] := height-1;
  72.    koords[2]^[5] := 0;       koords[2]^[6] := height-1;
  73.    (* Koordinaten für das Dreieck: *)
  74.    koords[3]^[1] := 3;       koords[3]^[2] := 2;
  75.    koords[3]^[3] := width-3; koords[3]^[4] := 2;
  76.    koords[3]^[5] := (width DIV 2);   koords[3]^[6] := height-3;
  77.    koords[3]^[7] := 2;       koords[3]^[8] := 2;
  78.    WITH borders[1]^ DO
  79.       (* Helle Seite *)
  80.       leftEdge    := 0;
  81.       topEdge     := 0;
  82.       frontPen    := 2;
  83.       backPen     := 0;
  84.       drawMode    := grd.jam1;
  85.       count       := 3;
  86.       xy          := koords[1];
  87.       nextBorder  := borders[2];
  88.    END;
  89.    WITH borders[2]^ DO
  90.       (* Dunkle Seite *)
  91.       leftEdge    := 0;
  92.       topEdge     := 0;
  93.       frontPen    := 1;
  94.       backPen     := 0;
  95.       drawMode    := grd.jam1;
  96.       count       := 3;
  97.       xy          := koords[2];
  98.       nextBorder  := borders[3];
  99.    END;
  100.    WITH borders[3]^ DO
  101.       (* Dreieck *)
  102.       leftEdge    := 0;
  103.       topEdge     := 0;
  104.       frontPen    := 1;
  105.       backPen     := 0;
  106.       drawMode    := grd.jam1;
  107.       count       := 4;
  108.       xy          := koords[3];
  109.       nextBorder  := NIL;
  110.    END;
  111.    RETURN borders[1];
  112. END CreateGRBorder;
  113.  
  114. PROCEDURE CreateSRBorder(width, height : INTEGER) : id.BorderPtr;
  115. VAR   borders  : ARRAY [1..3] OF id.BorderPtr;
  116.       koords   : ARRAY [1..3] OF POINTER TO ARRAY [1..8] OF INTEGER;
  117.       b        : SHORTINT;
  118. BEGIN
  119.    FOR b := 1 TO 3 DO
  120.       Allocate (borders[b], SIZE(id.Border));
  121.       Allocate (koords[b], 2*6);
  122.    END;
  123.    (* Koordinaten für die helle Seite: *)
  124.    koords[1]^[1] := 0;       koords[1]^[2] := height-2;
  125.    koords[1]^[3] := 0;       koords[1]^[4] := 0;
  126.    koords[1]^[5] := width;   koords[1]^[6] := 0;
  127.    (* Koordinaten für die dunkle Seite: *)
  128.    koords[2]^[1] := width;   koords[2]^[2] := 1;
  129.    koords[2]^[3] := width;   koords[2]^[4] := height-1;
  130.    koords[2]^[5] := 0;       koords[2]^[6] := height-1;
  131.    (* Koordinaten für das Dreieck: *)
  132.    koords[3]^[1] := 3;       koords[3]^[2] := 2;
  133.    koords[3]^[3] := width-3; koords[3]^[4] := 2;
  134.    koords[3]^[5] := (width DIV 2);   koords[3]^[6] := height-3;
  135.    koords[3]^[7] := 2;       koords[3]^[8] := 2;
  136.    WITH borders[1]^ DO
  137.       (* Helle Seite *)
  138.       leftEdge    := 0;
  139.       topEdge     := 0;
  140.       frontPen    := 1;
  141.       backPen     := 0;
  142.       drawMode    := grd.jam1;
  143.       count       := 3;
  144.       xy          := koords[1];
  145.       nextBorder  := borders[2];
  146.    END;
  147.    WITH borders[2]^ DO
  148.       (* Dunkle Seite *)
  149.       leftEdge    := 0;
  150.       topEdge     := 0;
  151.       frontPen    := 2;
  152.       backPen     := 0;
  153.       drawMode    := grd.jam1;
  154.       count       := 3;
  155.       xy          := koords[2];
  156.       nextBorder  := borders[3];
  157.    END;
  158.    WITH borders[3]^ DO
  159.       (* Dreieck *)
  160.       leftEdge    := 0;
  161.       topEdge     := 0;
  162.       frontPen    := 1;
  163.       backPen     := 0;
  164.       drawMode    := grd.jam1;
  165.       count       := 4;
  166.       xy          := koords[3];
  167.       nextBorder  := NIL;
  168.    END;
  169.    RETURN borders[1];
  170. END CreateSRBorder;
  171.  
  172. PROCEDURE SetMenuGadget (kind : LONGCARD; VAR previous : id.Gadget;
  173.           VAR ng : gd.NewGadget; taglist  : ud.TagItemPtr) : id.GadgetPtr;
  174. VAR   gad   : id.GadgetPtr;
  175. BEGIN
  176.    gad := gl.CreateGadgetA(gd.genericKind,previous,ng,taglist);
  177.    IF gad # NIL THEN
  178.       (* Ok. Gadget konnte erzeugt werden. Jetzt nehmen wir noch die
  179.        * eigenen Änderungen vor:
  180.        *)
  181.       WITH gad^ DO
  182.          flags       := id.GadgetFlagSet{id.gadgHImage};
  183.          activation  := id.ActivationFlagSet{id.relVerify};
  184.          gadgetRender:= CreateGRBorder(width, height);
  185.          selectRender:= CreateSRBorder(width, height);
  186.       END;
  187.    END;
  188.    RETURN gad;
  189. END SetMenuGadget;
  190.  
  191.  
  192. PROCEDURE HandleMenuGadget (mg : id.GadgetPtr; win : id.WindowPtr) : LONGINT;
  193. CONST ITEM_OUTOFBOUNDS = -42;    (* äquiv. mit ITEM_NOSELECTION *)
  194. TYPE  StrPtrArray = POINTER TO ARRAY [0..31] OF StrPtr;
  195. VAR   menuwin  : id.WindowPtr;   (* Dies Wird unser Menü sein.          *)
  196.       winWidth,
  197.       winHeight: INTEGER;        (* Breite und Höhe des Menü-Fensters.  *)
  198.       winLeft,
  199.       winTop   : INTEGER;        (* Linke obere Ecke des Menü-Fensters  *)
  200.       rp       : grd.RastPortPtr;(* ...des Menü-Fensters f. Zeichenoper.*)
  201.       ySize    : INTEGER;        (* Höhe des verwendeten Zeichensatzes  *)
  202.  
  203.       entry    : StrPtrArray;    (* Zgr. auf Array m. Adr. d. Zeichenk. *)
  204.       entries  : INTEGER;        (* Anzahl der Menüeinträge.            *)
  205.       maxwidth : INTEGER;        (* Breite des längsten Eintrags in Pix.*)
  206.       tl       : INTEGER;        (* Hilfsvariable                       *)
  207.  
  208.       activeItem : INTEGER;      (* Hervorgehobenes Item                *)
  209.       item       : INTEGER;      (* Akt. Item und Rückgabewert          *)
  210.       outOfBounds:BOOLEAN;       (* Mauszgr. innerhalb des Fensters?    *)
  211.  
  212.       msg      : id.IntuiMessagePtr;   (* Zgr. auf IntuiMessage         *)
  213.  
  214.       y        : INTEGER;        (* Diverse Hilfsvariablen...           *)
  215.       ende     : BOOLEAN;
  216.       tagBuffer : ARRAY [0..24] OF LONGINT;
  217.  
  218.    PROCEDURE Item (y : INTEGER) : INTEGER;
  219.    VAR   item  : INTEGER;
  220.    BEGIN
  221.       IF (y<=1) OR (y>=winHeight-3) THEN
  222.          RETURN ITEM_OUTOFBOUNDS;
  223.       ELSE
  224.          RETURN y DIV (ySize+1);
  225.       END;
  226.    END Item;
  227.    PROCEDURE ComplementItem (item : INTEGER);
  228.    BEGIN
  229.       grl.SetDrMd (rp, grd.DrawModeSet{grd.complement});
  230.       grl.RectFill (rp, 3, item*(ySize+1)+1, winWidth-3, (item+1)*(ySize+1));
  231.    END ComplementItem;
  232.  
  233. BEGIN
  234.    entries := 0;
  235.    maxwidth:= 0;
  236.    ySize := win^.iFont^.ySize;
  237.    entry := mg^.userData;        (* Hier steht das Array mit den Adressen
  238.                                   * der Zeichenketten der Einträge. *)
  239.    (* Anzahl der Einträge und maximale Länge eines Eintrages ermitteln: *)
  240.    WHILE entry^[entries] # NIL DO
  241.       tl := grl.TextLength(win^.rPort, entry^[entries], Length(entry^[entries]^));
  242.       IF tl > maxwidth THEN maxwidth := tl; END;
  243.       INC (entries);
  244.    END;
  245.    winWidth := maxwidth+6;
  246.    winHeight:= (entries+1)*ySize+2;
  247.    winLeft  := mg^.leftEdge + win^.leftEdge;
  248.    winTop   := mg^.topEdge  + win^.topEdge;
  249.    IF id.gimmeZeroZero IN win^.flags THEN
  250.       INC (winLeft, win^.borderLeft);
  251.       INC (winTop, win^.borderTop);
  252.    END;
  253.  
  254.    (* Jetzt das rahmenlose Fenster öffnen, welches dem Anwender ein Menü
  255.     * vorgaukelt: *)
  256.    menuwin := il.OpenWindowTagList(NIL,TAG(tagBuffer,
  257.       waLeft,           winLeft,
  258.       waTop,            winTop,
  259.       waInnerHeight,    winHeight,
  260.       waInnerWidth,     winWidth,
  261.       waAutoAdjust,     TRUE,
  262.       waGimmeZeroZero,  TRUE,
  263.       waBorderless,     TRUE,
  264.       waActivate,       TRUE,
  265.       waReportMouse,    TRUE,
  266.       waPubScreen,      win^.wScreen,
  267.       waIDCMP,          id.IDCMPFlagSet{mouseMove,mouseButtons,inactiveWindow},
  268.       ud.tagEnd));
  269.    IF menuwin=NIL THEN RETURN ITEM_CREATIONERR; END;
  270.  
  271.    (* Fenster geöffnet. Jetzt das Menü aufbauen: *)
  272.    rp := menuwin^.rPort;
  273.    grl.SetRast (rp,1);
  274.    grl.SetAPen (rp, 2);
  275.    grl.Move (rp, 0, 0);
  276.    grl.Draw (rp, winWidth-1, 0);
  277.    grl.Draw (rp, winWidth-1, winHeight-1);
  278.    grl.Draw (rp, 0, winHeight-1);
  279.    grl.Draw (rp, 0, 0);
  280.    grl.SetBPen (rp,1);
  281.    grl.SetAPen (rp,0);
  282.    FOR y := 0 TO entries DO
  283.       grl.Move (rp, 3, y*(ySize+1)+ySize);
  284.       grl.Text (rp, entry^[y], Length(entry^[y]^));
  285.    END;
  286.  
  287.    (* IDCMP-LOOP *)
  288.    activeItem := 0;
  289.    ComplementItem (activeItem);
  290.    outOfBounds := FALSE;
  291.    ende := FALSE;
  292.    WHILE NOT(ende) DO
  293.       el.WaitPort(menuwin^.userPort);
  294.  
  295.       msg := gl.GTGetIMsg(menuwin^.userPort);
  296.       WHILE msg#NIL DO
  297.          IF mouseMove IN msg^.class THEN
  298.             IF ((msg^.mouseX > 0) AND (msg^.mouseX < winWidth)) AND
  299.                ((msg^.mouseY > 0) AND (msg^.mouseY < winHeight-2)) THEN
  300.                (* nur, wenn wir uns innerhalb des Fensters befinden, wird
  301.                 * dieser Teil ausgeführt. *)
  302.                item := Item(msg^.mouseY);
  303.                IF item#activeItem THEN
  304.                   (* Nur, wenn sich der Mauszeiger über einem neuen Item
  305.                    * befindet, deaktivieren wir das alte und aktivieren das
  306.                    * neue item. *)
  307.                   IF NOT(outOfBounds) THEN
  308.                      (* Ausnahme: Wir deaktivieren das alte Item nicht,
  309.                       * wenn wir von außerhalb des Fensters wieder herein-
  310.                       * kommen. Das alte Item ist dann schon deaktiviert.
  311.                       *)
  312.                      ComplementItem (activeItem);
  313.                   END;
  314.                   outOfBounds := FALSE;
  315.                   activeItem := item;
  316.                   ComplementItem (activeItem);
  317.                ELSE
  318.                   (* Wenn der Mauszeiger immer noch über dem gleichen Item
  319.                    * steht, passiert nichts. *)
  320.                   IF outOfBounds THEN
  321.                      (* Ausnahme: Wir kommen von außerhalb des Fensters
  322.                       * wieder rein. Dann war dieses Item deaktiviert und
  323.                       * wir müssen es jetzt wieder aktivieren. *)
  324.                      ComplementItem (activeItem);
  325.                      outOfBounds := FALSE;
  326.                   END;
  327.                END;
  328.             ELSE
  329.                (* Außerhalb des Fensters, nix passiert. *)
  330.                IF NOT(outOfBounds) THEN
  331.                   (* Ausnahme: Wir waren gerade zuvor noch innerhalb des
  332.                    * Fensters, also deaktivieren wir das aktive Item. *)
  333.                   ComplementItem (activeItem);
  334.                   outOfBounds := TRUE;
  335.                END;
  336.             END;
  337.          ELSIF mouseButtons IN msg^.class THEN
  338.             ende := TRUE;
  339.          ELSIF inactiveWindow IN msg^.class THEN
  340.             item := ITEM_NOSELECTION;
  341.             ende := TRUE;
  342.          END;
  343.  
  344.          gl.GTReplyIMsg (msg);
  345.          msg := gl.GTGetIMsg(menuwin^.userPort);
  346.       END;
  347.    END;
  348.  
  349.    il.CloseWindow (menuwin);
  350.    RETURN item;
  351. END HandleMenuGadget;
  352.  
  353.  
  354. BEGIN
  355. END MenuGadget.
  356.